Support functions in -add-key-based-replacements

diff --git a/which-key-tests.el b/which-key-tests.el
index 4fcbf39538586b36ef6184dd2c95778de5813cbc..93e1dfa969f157e24726eb96f0c365f54b7ed2bb 100644 (file)
--- a/which-key-tests.el
+++ b/which-key-tests.el
@@ -49,12 +49,24 @@
   "Test `which-key--maybe-replace'. See #154"
   (let ((which-key-replacement-alist
          '((("C-c [a-d]" . nil) . ("C-c a" . "c-c a"))
-           (("C-c .+" . nil) . ("C-c *" . "c-c *")))))
+           (("C-c .+" . nil) . ("C-c *" . "c-c *"))))
+        (test-mode-1 t)
+        (test-mode-2 nil))
     (which-key-add-key-based-replacements
       "C-c ." "test ."
       "SPC ." "SPC ."
       "C-c \\" "regexp quoting"
-      "C-c [" "bad regexp")
+      "C-c [" "bad regexp"
+      "SPC t1" (lambda (kb)
+                 (cons (car kb)
+                       (if test-mode-1
+                           "[x] test mode"
+                         "[ ] test mode")))
+      "SPC t2" (lambda (kb)
+                 (cons (car kb)
+                       (if test-mode-2
+                           "[x] test mode"
+                         "[ ] test mode"))))
     (should (equal
              (which-key--maybe-replace '("C-c g" . "test"))
              '("C-c *" . "c-c *")))
@@ -77,7 +89,13 @@
     ;; see #155
     (should (equal
              (which-key--maybe-replace '("SPC . ." . "don't replace"))
-             '("SPC . ." . "don't replace")))))
+             '("SPC . ." . "don't replace")))
+    (should (equal
+             (which-key--maybe-replace '("SPC t 1" . "test mode"))
+             '("SPC t 1" . "[x] test mode")))
+    (should (equal
+             (which-key--maybe-replace '("SPC t 2" . "test mode"))
+             '("SPC t 2" . "[ ] test mode")))))
 
 (provide 'which-key-tests)
 ;;; which-key-tests.el ends here

diff --git a/which-key.el b/which-key.el
index d383866b7d6ee5cd344ecd3b09891254d797b707..63327cb9ba20eaca590fcacdf9a21db156112bc8 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -796,10 +796,13 @@ may either be a string, as in
 
 \(which-key-add-key-based-replacements \"C-x 1\" \"maximize\"\)
 
-or a cons of two strings as in
+a cons of two strings as in
 
 \(which-key-add-key-based-replacements \"C-x 8\" '(\"unicode\" . \"Unicode keys\")\)
 
+or a function that takes a \(KEY . BINDING\) cons and returns a
+replacement.
+
 In the second case, the second string is used to provide a longer
 name for the keys under a prefix.
 
@@ -809,9 +812,12 @@ replacements are added to
   ;; TODO: Make interactive
   (while key-sequence
     ;; normalize key sequences before adding
-    (let ((key-seq (key-description (kbd key-sequence))))
+    (let ((key-seq (key-description (kbd key-sequence)))
+          (replace (or (and (functionp replacement) replacement)
+                       (cdr-safe replacement)
+                       replacement)))
       (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
-                  (cons nil (or (car-safe replacement) replacement)))
+                  (if (functionp replace) replace (cons nil replace)))
             which-key-replacement-alist)
       (when (consp replacement)
         (push (cons key-seq (cdr-safe replacement))
@@ -835,9 +841,12 @@ addition KEY-SEQUENCE REPLACEMENT pairs) to apply."
          (or (cdr-safe (assq mode which-key--prefix-title-alist)) (list))))
     (while key-sequence
     ;; normalize key sequences before adding
-      (let ((key-seq (key-description (kbd key-sequence))))
+      (let ((key-seq (key-description (kbd key-sequence)))
+            (replace (or (and (functionp replacement) replacement)
+                         (cdr-safe replacement)
+                         replacement)))
         (push (cons (cons (concat "\\`" (regexp-quote key-seq) "\\'") nil)
-                    (cons nil (or (car-safe replacement) replacement)))
+                    (if (functionp replace) replace (cons nil replace)))
               mode-alist)
         (when (consp replacement)
           (push (cons key-seq (cdr-safe replacement))